perm filename XIP.FAI[0,BGB] blob
sn#178661 filedate 1975-09-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00040 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.
C00010 00003 ASCII JUMP TABLE.
C00013 00004 ASCII JUMP TABLE.
C00015 00005 FONT DEFAULT FILE NAMES.
C00018 00006 TEXT BUFFER SPECIFICATIONS.
C00021 00007 START ADDRESS ENTRY & MAIN EXECUTION.
C00024 00008 THREE INITIALIZATION ROUTINES.
C00028 00009 SUBR(XGPOUT) OUTPUT XGP BUFFER.
C00032 00010 SUBR(EOPAGE) END OF PAGE.
C00036 00011 SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00039 00012 SUBR(GETCHR) GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
C00042 00013 SUBR(MKFONT)
C00046 00014 TEXT JUSTFICATION COMMAND CHARACTER EXECUTION "J".
C00048 00015 TEXT MODE - CARRAIGE CONTROL ROUTINES.
C00051 00016 TEXT MODE ROUTINES.
C00052 00017 SET INTER LINE SPACING DEFAULT. "λ<number>" COMMAND.
C00054 00018 SUBR(JUSTIFY) PRINT A JUSTIFIED PARAGRAPH OF TEXT.
C00057 00019 SUBR(LNSCAN) LINE SCAN FOR SPACES COUNT.
C00061 00020 SUBR(LNJUST) LINE JUSTIFY AND PRINT.
C00064 00021 SUBR(TJLINE) CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
C00066 00022 FONT SELECT DELIMITERS.
C00068 00023 SUBR(MKSEG0) MAKE LINE SEGMENT.
C00071 00024 SUBR(MKSEG1) MAKE HEAVY LINES.
C00073 00025 SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
C00076 00026 EXECUTE III TEXT.
C00079 00027 EXECUTE VECTORS.
C00082 00028 SUBR(VIDEO)
C00086 00029 SUBR(VIDEO2)
C00089 00030 SUBR(INFILE) INDIRECT FILE COMMAND "@".
C00091 00031 XIP GRAPHICS COMMAND EXECUTION: I,V,R
C00093 00032 XIP GRAPHICS COMMAND EXECUTION: X,Y,O,L
C00095 00033 COMMAND EXECUTION P,H,α
C00096 00034 SUBR(SQRT,X)
C00099 00035 SUBR(REALIN)
C00101 00036 INPUT SMALL REAL NUMBER.
C00104 00037 SUBR(DPYDOT,X,Y) DISPLAY A DOT.
C00107 00038 SUBR(RNDBOX,WID,HGH,RAD) BOX WITH ROUNDED CORNERS AT ROW,COL.
C00110 00039 SUBR(XBOX) "B <width> <height>"
C00114 00040 SUBR(CIRC,RAD,ARCORG,ARCLEN) RADIUS - ARC ORG - ARC LENGTH.
C00117 ENDMK
C⊗;
TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.
OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF DZM[SETZM]↔OPDEF GO[JRST]
OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
↓P←←17
DEFINE POP0J<POPJ P,>
↓POP1J.:↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2 ;DECLARE ACCUMULATORS.
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){FOR VARNAM⊂(LIST)<VARNAM:0↔>}
DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
%←400000
DEFINE CAT $(A,B){A$B} ;CONCATENATION.
.PLEVEL←←0 ↔ .SLEVEL←←0 ;PDL COUNT & DEPTH OF SUBR NESTING.
;SUBROUTINE DECLARATION MACROS - SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
↓NAME:;}
;DEFINE ARGUMENT NAME MACRO.
DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }
;SUBROUTINE CALLING MACROS - CALL & SETQ.
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
IFDIF<><NAME>{PUSHJ P,NAME }
.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;STACK ACCESSING MACROS - PUSHP & POPP.
DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
DEFINE POPP(ARG) {POP P,ARG↔.PLEVEL←←.PLEVEL-1}
;ASCII JUMP TABLE.
;XWD TEXT_MODE,,COMMAND_MODE
A00: 0 ;null. ;00-07.
XSAVE ;"↓" Push current beam position.
XWD %+QQUOTE,DECHAP ;"α<str>" Declare chapter heading.
DESECT ;"β<str>" Declare section heading.
0 ;"∧"
0 ;"¬"
0 ;"ε"
XAOSPAGE;"π"
XXLINE ;"λ<number>" Set inter XGP line spacing. ;10↔17.
XWD %+HTAB,0 ;tab.
XWD %+LFEED,0 ;LF
0 ;VT.
XWD %+FFEED,FFEED;FF.
XWD %+CRETURN,0 ;CR.
XWD %+CHRTAB,0 ;"∞" REPEAT CHARACTER TO NEXT TAB POSITION.
0 ;"∂"
XWD DESECT,DFS+4;"⊂" LEFT FONT SELECT DELIMITER ;20-27.
XWD RFS+4,0 ;"⊃" RIGHT FONT SELECT DELIMITER
0 ;"∩"
0 ;"∪"
0 ;"∀"
MKFRAM ;"∃" Diagonostic.
IIISIM ;"⊗" III DISPLAY BUFFER - CORNER ORIGIN.
0 ;"↔"
0 ;"_" ;30-37.
0 ;"→"
XWD UNDERB,0 ;TILDE. Toggle Underlineing.
0 ;"≠"
XWD LFS+5,DFS+5 ;"≤" LEFT FONT SELECT DELIMITER
XWD RFS+5,0 ;"≥" RIGHT FONT SELECT DELIMITER
XWD %+FUCK,0 ;"≡"
0 ;"∨"
XWD %+SPACE,0 ;SPACE. ;40-47.
0 ;"!"
0 ;"""
0 ;"#"
PAGESEL ;"$" Page Select (like COPY's parens).
0 ;"%"
0 ;"&"
0 ;"'"
XWD LFS+2,DFS+2 ;"(" LEFT FONT SELECT DELIMITER ;50-57.
XWD RFS+2,0 ;")" RIGHT FONT SELECT DELIMITER
IIISIM ;"*" III DISPLAY BUFFER - CENTER ORIGIN.
IIISIM ;"+"
0 ;","
0 ;"-"
0 ;"."
0 ;"/"
BLOCK 12;"0-9" numerals are never to be commands ;60-67.
INSIX ;":" ;72-77.
0 ;";"
XWD LFS+1,DFS+1 ;"<" LEFT FONT SELECT DELIMITER
0 ;"="
XWD RFS+1,0 ;">" RIGHT FONT SELECT DELIMITER
0 ;"?"
INFILE ;"@" INDIRECT FILE COMMAND ;100-107.
;ASCII JUMP TABLE.
0 ;"A"
XBOX ;"B<width>,≤height≥;" Print Box.
XCIRCLE ;"C<radius>,<arc org>,<arc length>;"
0 ;"D"
0 ;"E"
XFONT ;"F<chr>" Select Font.
0 ;"G"
XHEAVY ;"H<digit>" HEAVY LINES. ;110-117.
AI ;"I" ABSOLUTE INVISIBLE VECTOR.
XJUSTM ;"J" Justification Switchs
0 ;"K"
XLOCUS ;"L<x>,<y>;" LOCUS (& LINE).
MKFONT ;"M<digit><filename>;" MAKE A FONT NUMBER.
0 ;"N"
XROTAT ;"O<arc>;" SET ORIENTATION.
XSETPAGE ;"P<integer>;" SET PAGE NUMBER. ;120-127.
FFEED+2 ;"Q" ;FORMFEED.
XRADIAL ;"R<radius1>,<radius2>;"
XSWINE ;"S" MAKE ROUNDED BOX center at current locus.
XSETAB ;"T" SET TABULATION COLUMNS FOR BACKSLASH.
0 ;"U"
AV ;"V" ABSOLUTE VISIBLE VECTOR.
XWINDO ;"W" WINDOW DECLARATION.
XXSCAL ;"X<xscale>,≤yscale≥;" SET SCALES. ;130-137.
0 ;"Y"
0 ;"Z"
XWD LFS+3,DFS+3 ;"[" LEFT FONT SELECT DELIMITER
XWD %+HTAB,0 ;"\" PSEUDO TAB.
XWD RFS+3,0 ;"]" RIGHT FONT SELECT DELIMITER
XRESTORE ;"↑"
0 ;"←"
0 ;"`"
BLOCK 7+8+8+3 ;lower case letters (a thru z).
XWD %+ESCTXT,ESCCOM ;"{"
CARTOUCHE ;"|" BOX WITH ROUNDED CORNERS.
0 ;ALT
ESCCOM ;"}"
0 ;RUBOUT
;FONT DEFAULT FILE NAMES.
FONT: 1
FONTAB: BLOCK =45
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
;DEFAULT FONT NUMERAL NAMES.
FNTNAM: 0 ;0 FONT (for inoperative statements).
;FIXED WIDTH FONTS.
SIXBIT/LPT/ ;1 LINE PRINTER.
SIXBIT/FIX13X/ ;2 FIXED WIDTH FONTS.
SIXBIT/FIX20/ ;3
SIXBIT/FIX25/ ;4
SIXBIT/FIX30/ ;5
SIXBIT/FIX40/ ;6
;NEWS GOTHIC.
SIXBIT/NGR13/ ;7 NEWS GOTHIC ROMAN.
SIXBIT/NGR20/ ;8
SIXBIT/NGR25/ ;9 LIGHTFACE.
SIXBIT/NGB25/ ;A BOLDFACE.
SIXBIT/NGR30/ ;B
SIXBIT/NGB30/ ;C
SIXBIT/NGR40/ ;D
;FANCY OR IRREGULAR FONTS.
SIXBIT/XMAS25/ ;E PSEUDO OLDE ENGLISH.
SIXBIT/BEESIX/ ;F
SIXBIT/GRK25/ ;G GREEK.
SIXBIT/SET1/ ;H TOVAR'S CREATION.
SIXBIT/SUB/ ;I
SIXBIT/SUP/ ;J
0 ;K
0 ;L
;BODONI.
SIXBIT/BDR25/ ;M
SIXBIT/BDI25/ ;N
SIXBIT/BDJ25/ ;O
SIXBIT/BDR25X/ ;P
SIXBIT/BDR30/ ;Q
SIXBIT/BDB30/ ;R
SIXBIT/BDR40/ ;S
SIXBIT/BDI40/ ;T
SIXBIT/BDR66/ ;U
0 ;V
0 ;W
;BASKERVILLE.
SIXBIT/BASB30/ ;X BOLDFACE.
SIXBIT/BASL30/ ;Y LIGHTFACE.
SIXBIT/BASI30/ ;Z ITALIC.
COMMENT ⊗ STANFORD FONT FILE FORMAT.---------------------------------
WORDS 0-177: XWD CHARACTER_WIDTH,CHARACTER_ADDRESS
WORDS 200-237: CHARACTER_SET_NUMBER ↔ HEIGHT ↔ MAX_WIDTH (IN BITS)
BASE LINE (BITS FROM TOP OF CHARACTER)
WORDS 240-377: ASCIZ/FONT DESCRIPTION/
REMAINDER OF FILE:
EACH CHARACTER:
CHARACTER_CODE,,WORD_COUNT+2
ROWS_FROM_TOP,,DATA_ROW_COUNT
BLOCK WORD_COUNT
--------------------------------------------------------------------⊗
;TEXT BUFFER SPECIFICATIONS.
CHRCNT: 0 ;NUMBER OF CHARACTERS REMAINING.
TXTPTR: 0 ;CURRENT TEXT POINTER.
TXTORG: 0 ;ORIGIN OF TEXT BUFFER.
TXTEND: 0 ;END OF TEXT BUFFER.
;MAIN SCANNER STATE.
CMODE: 0 ;-1 COMMAND MODE. 0 TEXT MODE.
XLINE: 5 ;EXTRA LINES BETWEEN ROWS OF CHARACTERS
EOP: 0 ;END OF PAGE FLAG.
EOF: 0 ;END OF FILE.
CHAR: 0 ;CURRENT CHARACTER.
;RESULTS: DISK FILE SPECIFICATION.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
;XGP PSEUDO BEAM POSITION.
ROW: 0 ↔ COL: 0
ORGXGP: 0 ↔ ENDXGP: 0 ;XGP RASTER PAGE BUFFER IN CORE.
;XGP RASTER DIMENSIONS.
WWIDTH←←=36 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1260.
MROWS←←=1900 ;NUMBER OF ROWS IS 1900.
BUFSIZ←←WWIDTH*MROWS
;III BUFFER DISPLAY.
IIIDX: =1024 ↔ IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
DROW:0 ↔ DCOL:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
COLMIN: =50 ;OF 1260 COLUMNS.
COLMAX: =1200
ROWMIN: =150 ;OF 1900 ROWS.
ROWMAX: =1800
TJMODE: -1 ;AUTO CRLF MODE.
TJFLAG: 0 ;-1 CENTER, +1 RIGHT JUSTIFICATION.
HEAVY: 0 ;LINE THICKNESS.
HEADER: 0 ;BYTE POINTER TO HEADER STRING.
HEADCN: 0 ;CHARACTER COUNT OF HEADER.
PAGENO: 0 ;PAGE NUMBER.
PAGELO: -1 ;SELECTED PAGE NUMBER.
PAGEHI: -1 ;SELECTED PAGE NUMBER.
XGP2D: BLOCK =2048 ;2-D BIT ADDRESSING TABLE.
DEFINE DOT(R,C){HLLZ 1,XGP2D(C)↔ROT 1,6↔HRRI 1,@XGP2D(R)↔DPB 0,1}
;START ADDRESS ENTRY & MAIN EXECUTION.
;------------------------------------------------------------------------------
PDL: BLOCK 100
SA: CALLI↔LAC P,[IOWD 100,PDL] ;CONTROL PUSH DOWN.
SETOM CMODE ;COMMAND MODE.
LAC[XWD FONTAB,FONTAB+1] ;CLEAR FONT CORE ADDRESSES.
DZM FONTAB↔BLT FNTPPN-1
LAC[SIXBIT/LPTFNT/] ;INPUT DEFAULT FONT.
HLLZM FILNAM↔HRLZM EXTION
LAC FNTPPN↔DAC PPPN
CALL(DEFONT,[1]) ;DEFINE FONT NUMERAL 1.
CALL(MKXBUF) ;MAKE XGP BUFFER,
CALL(MKTABL) ;MAKE XGP 2-D ADDRESS TABLE.
CALL(COMSCAN) ;COMMAND LINE SCAN.
DZM EOF ;END OF FILE, END OF PAGE.
BEGIN MAIN;.............................
L0: LAC ROWMIN↔DAC ROW
LAC COLMIN↔DAC COL↔DZM EOP
L1: SKIPE EOP↔GO L3 ;END OF PAGE ?
CALL(GETCHR) ;FETCH A CHARACTER.
SKIPE EOF↔GO L3 ;END OF FILE ?
SKIPE CMODE↔GO LCOMM↔GO LTEXT ;COMMAND MODE=-1 OR TEXT MODE=0;
L3: CALL(XGPOUT) ;OUTPUT XGP PAGE BUFFER.
SKIPN EOF↔GO L0
EXIT
;.......................................
;COMMAND MODE CHARACTER.
LCOMM: CAIL 1,"a"↔CAILE 1,"z" ;TEST FOR LOWER CASE LETTERS.
SKIPA↔SUBI 1,40 ;CONVERT LOWER CASE LETTERS.
CDR A00(1) ;COMMAND MODE CHARACTER ROUTINE.
SKIPE↔CALL(@0)↔GO L1 ;EXECUTE A COMMAND (OR NOP).
;.......................................
;TEXT MODE CHARACTER.
LTEXT: SKIPE TJFLAG↔GO[CALL(TJLINE)↔GO L1] ;CENTER OR RIGHT JUSTIFY.
CAR 0,A00(1)↔TRZ %↔JUMPE 0,.+3 ;TEXT MODE CHARACTER.
CALL(@0)↔GO L1 ;TEXT MODE SUBROUTINES.
CALL(PRINT)↔GO L1 ;PRINT UNJUSTIFIED CHARACTER.
BEND MAIN;---------------------------------------------------------------------
;THREE INITIALIZATION ROUTINES.
SUBR(MKXBUF) ;MAKE XGP PAGE BUFFER.
COMMENT .---------------------------------------------------------------------.
CDR JOBFF↑↔ADDI 10↔DAC ORGXGP
ADDI BUFSIZ-1↔DAC ENDXGP↔ADDI =40↔DAP JOBFF
CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER.)]
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@JOBREL↑
POP0J
ENDR MKXBUF;3/24/74(BGB)--------------------------------------------------------
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
COMMENT .---------------------------------------------------------------------.
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔AOS
TLO 4301↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=2048,XGP2D ;2 AOBJN TABLE POINTER TO TABLE.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
ENDR MKTABL;BGB 24 MAY 1973 ---------------------------------------------------
SUBR(COMSCAN) ;INITIAL COMMAND LINE SCAN.
COMMENT .---------------------------------------------------------------------.
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
RESCAN↔INCHSL↔EXIT ;READ CHARACTER LEFT OF SEMICOLON.
CAIN 15↔EXIT ;EXIT NO SEMICOLON.
CAIE";"↔GO .-5↔DZM CHRCNT
CDR JOBFF↔HRLI 440700 ;TEXT BUFFER POINTERS.
DAC TXTPTR↔DAC TXTORG
INCHSL 1↔EXIT ;READ FIRST CHARACTER.
DZM BUGFLG#↔CAIN 1,"!" ;"!" FORCES WAIT AFTER RESCAN.
SETOM BUGFLG↔GO .+3
INCHSL 1↔GO .+4↔AOS CHRCNT ;READ REMAINING CHARACTERS.
IDPB 1,0↔GO .-4↔DAC TXTEND
AOS↔DAP JOBFF
SKIPN BUGFLG↔POP0J
OUTSTR[ASCIZ/BEGIN./] ;WAIT FOR DEBUGGER.
INCHRW↔CRLF↔POP0J
ENDR COMSCAN;3/25/74(BGB)------------------------------------------------------
SUBR(XGPOUT) OUTPUT XGP BUFFER.
COMMENT .---------------------------------------------------------------------.
SKIPE PAGENO↔CALL(EOPAGE) ;PAGE NUMBERING.
;PUT XGP CONTROL WORD IN EACH ROW.
LAC 0,[1B11+=250B23+WWIDTH-1] ;COLUMN ZERO POSITION.
LAC 1,ORGXGP↔MOVEI 2,MROWS
DAC 0,(1)↔ADDI 1,WWIDTH↔SOJG 2,.-2
MOVSI -BUFSIZ-5 ;2+BUFSIZ+3
HRR ORGXGP↔SUBI 3
DAC DUMARG ;DUMP ARGUMENT.
;SETUP END CUTS AND SPACES.
LAC 1,ORGXGP↔SUBI 1,3
PUSH 1,[1B0] ;CUT AT TOP OF PAGE.
PUSH 1,[=200B11] ;3/4" MARGIN SPACE AT TOP OF PAGE.
LAC 1,ENDXGP
PUSH 1,[=150B11] ;3/4" MARGIN SPACE AT BOTTOM OF PAGE.
PUSH 1,[1B0] ;CUT AT THE BOTTOM OF PAGE.
PUSH 1,[0] ;LAST WORD OF XGP BUFFER.
;PRINT A PAGE ON THE XGP.
L1: OUTSTR[ASCIZ/PAGE/]
CALL(TYPEPG) ;TYPE OUT PAGE NUMBER.
LAC PAGENO
SKIPGE PAGELO↔GO .+5 ;-1 IGNORE PAGE SELECT
CAMLE 0,PAGEHI↔EXIT ;PAGE SELECT
CAMGE 0,PAGELO↔GO L2
INIT 2,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK
OUTSTR[ASCIZ/ TO XGP.../]
OUT 2,DUMARG ;FIRST COPY.
SKIPE SIXFLG↔GO[
OUTCHR ["2"]↔OUT 2,DUMARG ;2ND
OUTCHR ["3"]↔OUT 2,DUMARG ;3RD
OUTCHR ["4"]↔OUT 2,DUMARG ;4TH
OUTCHR ["5"]↔OUT 2,DUMARG ;5TH
GO .+1]
UNLOCK↔RELEASE 2,
L2: CDR ORGXGP↔SETZM@↔DIP↔AOS↔BLT @ENDXGP ;CLEAR XGP PAGE BUFFER.
OUTSTR[ASCIZ/ FINISHED.
/]↔ SKIPE PAGENO↔AOS PAGENO ;INCREMENT PAGE COUNT.
LAC ROWMIN↔DAC ROW↔LAC COLMIN↔DAC COL↔DZM EOP ;TOP OF NEXT PAGE.
POP0J
DUMARG: 0↔0
ENDR XGPOUT;-------------------------------------------------------------------
SUBR(TYPEPG)
COMMENT .-----------------------------------------------------------.
SKIPN 1,PAGENO↔POP0J↔OUTCHR[" "]
CAIL 1,=100↔GO[IDIVI 1,=100↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+2]
CAIL 1,=10 ↔GO[IDIVI 1,=10 ↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+1]
ADDI 1,"0"↔OUTCHR 1↔POP0J
ENDR TYPEPG;---------------------------------------------------------
SIXFLG: 0
INSIX: SETOM SIXFLG↔GO INFILE
SUBR(EOPAGE) ;END OF PAGE.
COMMENT .---------------------------------------------------------------------.
PUSH P,TJMODE↔PUSH P,TXTPTR↔PUSH P,CHRCNT↔PUSH P,EOF ;SAVE TEXT BUFFER STATUS.
MOVEI =1700↔DAC ROW↔SETOM TJFLAG↔DZM TJMODE ;BOTTOM CENTER OF PAGE.
;CONVERT PAGE NUMBER TO ASCII.
DZM CHRCNT↔LAC[POINT 7,TXT]↔DAC TXTPTR
MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
LAC PAGENO
CAIL =100↔GO[IDIVI =100
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+2]
CAIL =10 ↔GO[IDIVI =10
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+1]
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
LAC[POINT 7,TXT]↔DAC TXTPTR
;COMPUTE CENTER COLUMN AND PRINT.
CALL(TJLINE)↔SKIPA
L1: CALL(PRINT)↔CALL(GETCHR)
CAIE 1,15↔GO L1
;PRINT SECTION HEADING AT TOP OF PAGE FLUSH RIGHT.
SKIPN HEADER↔GO L3
LAC HEADROW↔DAC ROW↔SETZM TJFLAG
LAC HEADER↔DAC TXTPTR
LAC HEADCN↔DAC CHRCNT
CALL(TJLINE)↔SKIPA
L2: CALL(PRINT)↔CALL(GETCHR)
CAIE 1,15↔GO L2
;PRINT SECTION HEADING AT TOP OF PAGE FLUSH LEFT.
SKIPN HPTR2↔GO L3 ;EXISTENCE ?
LAC HEADROW↔DAC ROW↔DZM COL ;ROW & COL.
LAC HPTR2↔DAC TXTPTR↔MOVEI 777↔DAC CHRCNT ;PTR & CNT.
SKIPA↔CALL(PRINT)↔CALL(GETCHR) ;PRINT HEADING.
CAIN 1,9↔CALL(HTAB)
CAIE 1,"⊃"↔GO .-5 ;TERMINATOR.
;RESTORE TEXT BUFFER STATUS.
L3: POP P,EOF↔POP P,CHRCNT↔POP P,TXTPTR↔POP P,TJMODE
POP0J
TXT: BLOCK 5
ENDR EOPAGE;---------------------------------------------------------
DECHAP:
MOVEI =152;ADD DROW↔SUB XLINE↔DAC HEADROW#
LAC TXTPTR↔DAC HEADER↔SETZM HEADCN ;"α <chapter heading>;"
CALL(GETCHR)
CAIN 1,";"↔GO[SETZM HEADER↔POP0J] ;EMPTY HEADER ";".
SKIPA
CALL(GETCHR)↔AOS HEADCN↔CAIE 1,";"↔GO .-3
MOVEI 15↔DPB TXTPTR↔POP0J
DESECT:
LAC TXTPTR↔DAC HPTR2
MOVEI LFS+4↔GO LFS+4 ;LEFT FONT SELECT.
DECLARE{HPTR2}
PAGESEL:
CALL(REALIN)↔FIXX↔DAC PAGELO↔DAC PAGEHI
CAIN 1,":"↔GO .+3↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔DAC PAGEHI
POP0J
SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
COMMENT .---------------------------------------------------------------------.
;Implicit Arguments to PRINT are ROW, COL, CHAR,
;FONT, FONTAB, ORGXGP, ENDXGP, TJMODE.
ACCUMULATORS{G,B,B2,M,N,I,X16}
SKIPN CHAR↔POP0J ;IGNORE NULL CHARACTERS.
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP0J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,CHAR ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW
IMULI WWIDTH
ADD ORGXGP↔HRRZM B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL
SKIPE TJMODE↔GO .+3 ;CLIP LINE OVERFLOW IF TJMODE=0
CAML 0,COLMAX↔POP0J
IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
MOVEI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1
POP0J
ENDR PRINT;BGB 23 MAY 1973 ----------------------------------------------------
SUBR(GETCHR) GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
COMMENT .-----------------------------------------------------------.
SOSL CHRCNT↔GO[
ILDB 1,TXTPTR↔JUMPE 1,.-1
DAC 1,CHAR↔POP0J]
SETOM EOF↔SETZ 1,
POP0J
ENDR GETCHR;5/30/73(BGB)---------------------------------------------
NEXTCHR: LAC 1,TXTPTR↔ILDB 1,1↔POP0J
SUBR(GETFIL) ;GET FILE SPECIFICATION - SKIP OK.
COMMENT .---------------------------------------------------------------------.
C ←← 1 ;CHARACTER. ;ACCUMULATORS.
N ←← 2 ;COUNT.
Q ←← 4 ;BYTE POINTER.
DZM FILNAM↔DZM EXTION ;CLEAR FILENAME SPECIFICATION.
DZM EXTION+1↔DZM PPPN
LAC Q,[POINT 6,FILNAM,-1]↔MOVEI N,6
L: CALL(GETCHR)
CAIN C,15↔GO[CALL(GETCHR)↔GO EOL]
CAILE C,"z"↔POP0J
CAIL C,"a"↔SUBI C,40 ;CONVERT LOWER CASE
CAIN C,"."↔GO[LAC Q,[POINT 6,EXTION,-1]↔MOVEI N,3↔GO L]
CAIN C,"["↔GO[LAC Q,[POINT 6,PPPN,-1] ↔MOVEI N,3↔GO L]
CAIN C,","↔GO[LAC Q,[POINT 6,PPPN,17] ↔MOVEI N,3↔GO L]
CAIN C,"]"↔CALL(GETCHR)
CAIN C,";"↔GO EOL ;XIP COMMAND POSTFIX.
CAIN C,"("↔GO EOL ;PAGE SELECT.
CAIG C," "↔GO EOL
SOJL N,L↔SUBI C,40 ;COUNT'EM AND CONVERT TO SIXBIT.
IDPB C,Q↔GO L ;PACK CHARACTER INTO SPECIFICATIONS.
EOL:
CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
CAIN C,"("↔CALL(PAGESEL)
AOS(P)↔POP0J
ENDR GETFIL;5/30/73(BGB)---------------------------------------------
SUBR(MKFONT)
CALL(GETCHR)
CAIL 1,"a"↔SUBI 1,40
CAIL 1,"A"↔SUBI 1,"A"-"9"-1
SUBI 1,"0"↔DAC 1,FONT ;FONT NUMERAL OR LETTER.
CALL(GETFIL)↔POP0J ;FONT FILE NAME.
CALL(DEFONT,FONT)↔POP0J
ENDR MKFONT;
SUBR(DEFONT,N) LOAD FONT NUMERAL N.
COMMENT .-----------------------------------------------------------.
LAC N↔DAC FONT
;FIND FONT FILE.
INIT 1,17↔SIXBIT/DSK/↔0↔GO[FATAL(CAN'T INIT DSK)]
LOOKUP 1,FILNAM↔GO[MOVEI 'FNT'↔SKIPN EXTION↔HRLZM EXTION
LOOKUP 1,FILNAM↔GO[LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
LOOKUP 1,FILNAM↔GO[OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔GO L3]↔GO L2]↔GO L2]
;DUMP INPUT FONT FILE TO TOP OF CORE.
L2: LAC 1,FONT↔CDR 2,JOBFF ;FONT NUMBER.
LAC 0,2↔DAC FONTAB(1) ;FONT BASE ADDRESS.
HLL PPPN↔SOS↔DAC INARG ;IOWD DUMP ARGUMENT.
MOVS PPPN↔MOVMS↔ADDI 1(2) ;TOP OF THE FONT.
DAP JOBFF↔CORE↔HALT ;EXPAND CORE.
IN 1,INARG↔SKIPA↔HALT
CALL(SETFNT)
L3: RELEASE 1,↔POP1J↔ INARG:0↔0
ENDR DEFONT;2/7/73(TVR)2/25/73(BGB)----------------------------------
SUBR(SETFNT) SETUP A FONT, IMPLICIT ARGUMENT FONT.
COMMENT .-----------------------------------------------------------.
LAC 1,FONT↔CDR 2,FONTAB(1) ;GET FONT BASE ADDRESS.
SKIPN 2↔POP0J ;EXIT WHEN FONT MISSING.
MOVEI =40↔DAC DROW ;LINE FEED DEFAULT.
SKIPE 1,201(2)↔DAC 1,DROW ;LINE FEED SPECIFIED.
LAC XLINE↔ADDM DROW ;INTER LINE SPACING.
MOVEI =25↔DAC DCOL ;SPACE DEFAULT.
SKIPE 1,202(2)↔DAC 1,DCOL ;SPACE SPECIFIED.
POP0J
ENDR SETFNT;2/7/72(TVR)----------------------------------------------
SUBR(XFONT) ;"F<N>" FONT SELECT.
COMMENT .-----------------------------------------------------------.
CALL(GETCHR)
CAIN 1,"."↔POP0J ;NO CHANGE.
CAIGE 1,"0"↔POP0J
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
DAC 1,FONT
SKIPE FONTAB(1)↔POP0J ;IS FONT IN CORE YET.
LAC FNTNAM(1)↔DAC FILNAM ;FONT NAME
LAC[SIXBIT/FNT/]↔DAC EXTION ;FONT EXTENSION.
LAC FNTPPN↔DAC PPPN ;DEFAULT FONT PPPN.
CALL(DEFONT,FONT)↔POP0J
ENDR XFONT;3/26/74(BGB)----------------------------------------------
;TEXT JUSTFICATION COMMAND CHARACTER EXECUTION "J".
;EXECUTE "J" COMMAND.----------------------------------------------------------
XJUSTM:
CALL(GETCHR)↔MOVEI 1
;TJMODES:
CAIN 1,"A"↔SETOM TJMODE ;-1 JA JUSTIFY AUTOMATIC CRLF.
CAIN 1,"V"↔DZM TJMODE ; 0 JV JUSTIFY VIDEO CLIPPED.
CAIN 1,"U"↔DAC TJMODE ;+1 JU JUSTIFY FILL LEFT & RIGHT.
;TJFLAG:
CAIN 1,"C"↔SETOM TJFLAG ;-1 JC JUSTIFY STRING CENTER.
CAIN 1,"R"↔DAC TJFLAG ;+1 JR JUSTIFY STRING RIGHT.
POP0J
;------------------------------------------------------------------------------
SPACE:
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
ADDM 0,COL ;NEW CARRIAGE POSITION.
POP0J
CRETURN:
LAC 1,COLMIN↔DAC 1,COL
DZM TABCNT
POP0J
LFEED:
LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
LAC 1,201(1) ;MAXIMUM HEIGHT.
ADD 1,XLINE
ADDB 1,ROW
CAML 1,ROWMAX↔SETOM EOP ;FALL OFF THE BOTTOM OF THE COLUMN.
POP0J
;TEXT MODE - CARRAIGE CONTROL ROUTINES.
SUBR(HTAB)
COMMENT .---------------------------------------------------------------------.
AOS 2,TABCNT ;TABS SEEN ON THIS LINE.
;TABLE LOOKUP TAB (IF WE CAN).
ADDI 2,TABTAB
CAMLE 2,TABTAB↔GO L1 ;TOO MANY ?
LAC (2)↔DAC COL
GO L2
;COMPUTED TAB (IF WE MUST).
L1: CAIN 1,"\"↔GO L2 ;BACK SLASH ?
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
LAC 1,COL↔SUB 1,COLMIN ;CARRIAGE POSITION.
IDIV 1,0↔ANDCMI 1,7 ;THE OCTADE OF THE NUMBER OF SPACES.
ADDI 1,8 ;NEXT OCTADE.
IMUL 1,0 ;NEW CARRIAGE POSITION.
ADD 1,COLMIN↔DAC 1,COL
L2: SKIPLE TJMODE↔CALL(JUSTIFY) ;FILL JUSTIFIED PARAGRAPH.
POP0J
ENDR HTAB;BGB 26 JULY 1974 ----------------------------------------------------
SUBR(CHRTAB)
COMMENT .---------------------------------------------------------------------.
AOS 1,TABCNT↔ADDI 1,TABTAB ;INCREM TAB COUNT INTO TABLE.
CAMLE 1,TABTAB↔POP0J ;TOO MANY TABS ALREADY.
LAC 10,(1)↔SUB 10,COL↔JUMPLE 10,.-3 ;NUMBER OF XGP COLUMNS TO GO.
CALL(GETCHR) ;CHARACTER TO BE REPEATED.
LAC 1,FONT↔SKIPN 1,FONTAB(1)↔POP0J
ADD 1,CHAR↔CAR 1,(1) ;COLUMN WIDTH OF THE CHARACTER.
IDIV 10,1↔ADDM 11,COL↔DAC 10,TMP# ;TAKE THE FRACTION FIRST.
SOSGE TMP↔POP0J
CALL(PRINT)↔GO .-3
ENDR CHRTAB;-------------------------------------------------------------------
XSETAB: ;T<expr>,<expr>,...;
MOVEI TABTAB↔DAC TABTAB
CALL(REALIN)↔FIXX
SKIPG↔POP0J ;T-1 CLEARS THE TAB TABLE.
AOS TABTAB↔DAC 0,@TABTAB ;Push TAB expression into table.
CAIN 1,","↔GO XSETAB+2
POP0J
;------------------------------------------------------------------------------
TABCNT: 0 ;NUMBER OF TABS SEEN SO FAR ON THIS LINE.
TABTAB: TABTAB↔BLOCK 40 ;TAB TABLE OF TABULATION COLUMN SETTINGS.
;TEXT MODE ROUTINES.
ESCTXT:
SETOM CMODE
POP0J ;ESCAPE TEXT - ENTER COMMAND MODE.
ESCCOM:
CAIN 1,"{"↔CALL(PRINT) ;TEST FOR LEFT-CURLY IN COMMAND MODE.
DZM CMODE
POP0J ;ESCAPE COMMAND - ENTER TEXT MODE.
FFEED:
SKIPLE TJMODE↔POP0J ;IGNORE FORM FEEDS UNDER JUSTIFICATION.
SETOM EOP
POP0J
QQUOTE: ;α PRINT FOLLOWING CHARACTER.
CALL(GETCHR)
CALL(PRINT)
POP0J
;SET INTER LINE SPACING DEFAULT. "λ<number>" COMMAND.
XXLINE:
CALL(REALIN)
FIXX↔MOVMM XLINE
POP0J
;SET WINDOW (OR MARGINS). W<colmin>,<colmax>,<rowmin>,<rowmax>;
XWINDO:
CALL(REALIN)↔FIXX↔MOVMM COLMIN↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM COLMAX↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM ROWMIN↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM ROWMAX↔ POP0J
XSAVE: ;"↓" PUSH ROW COMMAND.
LAC SAVPDL
PUSH ROW
PUSH COL
DAC SAVPDL
POP0J
XRESTORE: ;"↑" POP ROW COMMAND.
LAC SAVPDL
POP COL
POP ROW
DAC SAVPDL
POP0J
SAVPDL: ;SAVE-RESTORE PDL.
IOWD 10,SAVPDL+1
BLOCK 10
SUBR(MKFRAM) ;MARKS BORDER OF XGP BUFFER ON PAGE "∃".
COMMENT .-----------------------------------------------------------.
SETO ;BLACK BITS.
LAC 1,ORGXGP↔MOVEI 2,MROWS
L1: DPB 0,[POINT 9,1(1),8] ;LEFT BORDER 9-BITS WIDE.
DPB 0,[POINT 9,=35(1),35] ;RIGHT BORDER 9-BITS WIDE.
ADDI 1,WWIDTH↔SOJG 2,L1
MOVSI 1,-9*=36
HRR 1,ORGXGP
L2: SETOM (1) ; TOP OF HEADER.
SETOM =91*=36(1) ; TOP OF TEXT AREA.
SETOM =1791*=36(1) ;BOTTOM OF TEXT AREA.
SETOM =1891*=36(1) ;BOTTOM OF FOOTER.
AOBJN 1,L2↔POP0J
ENDR MKFRAM;---------------------------------------------------------
SUBR(JUSTIFY) ;PRINT A JUSTIFIED PARAGRAPH OF TEXT.
COMMENT ⊗------------------------------------------------------------
A justified paragraph has five possible terminations: 1. end
of file; 2. escape character; 3. form feed; 4. CRLF-TAB; 5.
CRLF-CRLF. The main role of this routine is to find the end of the
paragraph; then it calls LNSCAN and LNJUST until all the full lines
are printed.
;-----------------------------------------------------------------------------⊗
PUSH P,TXTPTR ;SAVE INITIAL STATE OF THE SCANNER.
PUSH P,CHRCNT
L1: LAC TXTPTR↔DAC ENDPTR ;SAVE PTR TO POTENTIAL END CHARACTER.
CALL(GETCHR)
SKIPE EOF↔GO L2 ;1. END OF FILE EXCLUSIVE.
CAIN 1,"{"↔GO L2 ;2. ESCAPE CHARACTER EXCLUSIVE.
CAIN 1,14 ↔GO L2 ;3. FORM FEED EXCLUSIVE.
CAIE 1,15 ↔GO L1 ;SKIP ON 1ST CARRIAGE RETURN.
;CARRIAGE RETURN LOOK AHEAD.
LAC 0,TXTPTR
ILDB 1,0↔CAIE 1,12↔GO L1 ;LINE FEED INCLUSIVE.
DAC 0,ENDPTR
ILDB 1,0↔CAIN 1,11↔GO L2 ;4. CRLF TAB.
CAIE 1,15↔GO L1 ;2ND CARRIAGE RETURN.
ILDB 1,0↔CAIE 1,12↔GO L1 ;5. CRLF CRLF.
;FOUND END OF PARAGRAPH (INCLUSIVE AND EXCLUSIVE).
L2: POP P,CHRCNT ;RESTORE SCANNER TO INITIAL POSITION.
POP P,TXTPTR
;PRINT ALL THE FULL LINES OF THE PARAGRAPH.
L3: PUSH P,FONT↔CALL(LNSCAN) ;LINE SCAN FOR SPACES.
POP P,0↔CAMN FONT↔GO .+3 ;RESTORE FONT AT START OF LINE.
DAC 0,FONT↔CALL(SETFNT)
CALL(LNJUST) ;LINE JUSTIFY AND PRINT.
SKIPE EOP↔CALL(XGPOUT) ;PAGE OVER FLOW.
LAC TXTPTR↔CAME ENDPTR↔GO L3 ;TEST FOR END OF PARAGRAPH.
POP0J
;BYTE POINTER TO LAST CHARACTER OF THE PARAGRAPH INCLUSIVE.
↑ENDPTR: 0 ;IMPLICIT ARGUMENT FOR LNSCAN.
ENDR JUSTIFY;9/20/73(BGB)--------------------------------------------
SUBR(LNSCAN) ;LINE SCAN FOR SPACES COUNT.
COMMENT ⊗------------------------------------------------------------
Scan for right margin overflow, while keeping track of the
number of spaces seen and the position of the last space seen.
--------------------------------------------------------------------⊗
ACCUMULATORS{CHR}
;INITIALIZATION.
LAC COL↔DAC COLUMN ;TJ LEFT MARGIN.
DZM SPACNT↔DZM SPAPTR↔DZM SPACOL
LAC TXTPTR↔DAC LNPTR
DZM SPAFLG ;IGNORE LEADING SPACES.
;TEST FOR END OF LINE SCAN.
L1: LAC LNPTR↔CAMN ENDPTR↔GO[ ;EXIT END OF PARAGRAPH.
DZM SPAPTR↔DZM SPACNT↔POP0J]
LAC COLUMN↔CAML COLMAX↔POP0J ;EXIT LINE FULL.
;FETCH A CHARACTER.
ILDB CHR,LNPTR
CAIN CHR,"α"↔GO[ILDB CHR,LNPTR↔GO L3] ;QUOTED CHARACTER.
CAIN CHR,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN CHR,00↔GO L1 ;IGNORE NULLS.
CAIN CHR,11↔MOVEI CHR,40 ;CONVERT TAB INTO A SPACE.
CAIN CHR,15↔MOVEI CHR,40 ;CONVERT CR INTO A SPACE.
;SAVE THE STATUS OF THE LATEST SPACE.
CAIE CHR,40↔GO L2
AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
AOS SPACNT ;INCREMENT SPACE COUNT.
LAC COLUMN↔DAC SPACOL ;SAVE SPACE POSITION.
LAC LNPTR↔DAC SPAPTR ;SAVE SPACE BYTE POINTER.
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF SPACE.
SKIPE DOUBLE↔ASH 0,1 ;DOUBLE WIDTH SPACE.
ADDB 0,COLUMN↔GO L1↔GO L3
;DECODE FONT SELECT DELIMITERS.
L2: CAR A00(CHR)↔TRZN %↔SKIPN↔GO L3 ;JUMPS WHEN NOT A FONT SELECT.
CALL(@0)↔GO L1 ;SKIPS WHEN NOT A FONT SELECT.
;ACCUMULATE CHARACTER WIDTHS - NOT SPACE.
L3: SETOM SPAFLG#↔DZM DOUBLE#
CAIN CHR,"."↔SETOM DOUBLE
CAIN CHR,"?"↔SETOM DOUBLE
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF CHARACTER.
ADDB 0,COLUMN↔GO L1
;GLOBAL VARIABLES FOR COMMUNICATION TO LNJUST.
↑LNPTR: 0 ;END OF LINE POINTER.
↑SPACNT:0 ;SPACE COUNT.
↑SPAPTR:0 ;BYTE POINTER TO LATEST SPACE.
↑SPACOL:0 ;COLUMN POSITION OF LATEST SPACE.
COLUMN: 0 ;LOOK AHEAD COLUMN POSITION.
ENDR LNSCAN;9/20/73(BGB)---------------------------------------------
SUBR(LNJUST) ;LINE JUSTIFY AND PRINT.
COMMENT .---------------------------------------------------------------------.
;IMPLICIT ARGUMENTS:
PTR←←14
DZM PRNFLG# ;PRNFLG=0 UNTIL A CHARACTER IS PRINTED.
LAC COLMAX↔SUB SPACOL↔DAC EXTRA ;EXTRA SPACE.
SKIPLE SPACNT↔SOS SPACNT↔DZM SPAFLG ;IGNORE LEADING SPACES.
;PRINT CHARACTERS - ADJUST SPACE SIZES.
L1: LAC TXTPTR
CAMN ENDPTR↔GO EOL ;TEST FOR END OF PARAGRAPH.
CAMN LNPTR↔GO EOL ;TEST FOR ABNORMAL END OF LINE.
CALL(GETCHR)↔LAC TXTPTR
CAMN SPAPTR↔GO EOL ;TEST FOR NORMAL END OF LINE.
CAIN 1,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN 1,00↔GO L1 ;IGNORE NULLS.
CAIN 1,11↔MOVEI 1,40 ;CONVERT TAB INTO A SPACE.
CAIN 1,15↔MOVEI 1,40 ;CONVERT CR INTO A SPACE.
CAIN 1,"α"↔GO[CALL(GETCHR)↔GO L22];PREFIX α QUOTED CHARACTER.
CAIE 1,40↔SETOM SPAFLG#
CAIE 1,40↔DZM DOUBLE# ;NOT SPACE - RESET.
CAIE 1,"."↔CAIN 1,"?"↔SETOM DOUBLE# ;PERIOD OR QUESTION MARK.
DAC 1,CHAR
;FONT SELECT DELIMITERS.
CAR A00(1)↔TRZN %↔SKIPN↔GO .+3 ;JUMPS WHEN NOT A FONT SELECT.
CALL(@0)↔GO L1
LAC 1,CHAR
;PRINT THE CHARACTER.
L22: CAIN 1,40↔GO L2↔SETOM PRNFLG#
CALL(PRINT)
GO L1
;COMPUTE A VARIABLE SPACE SIZE.
L2: AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
SETZ↔SKIPN SPACNT↔GO L3 ;TEST FOR NO VARIABLE SPACES.
LAC 0,EXTRA↔IDIV 0,SPACNT
SOS SPACNT
LAC 1,EXTRA↔SUB 1,0↔DAC 1,EXTRA
;PRINT A VARIABLE SPACE.
L3: LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
CAR 1,40(1) ;WIDTH OF NORMAL SPACE.
SKIPE DOUBLE↔ASH 1,1 ;DOUBLE WIDTH SPACE.
ADD 1,0↔ADDM 1,COL ;ADVANCE COL VARIABLE SPACE.
GO L1
;EXECUTE A CARRIAGE RETURN LINE FEED.
EOL: SKIPN PRNFLG↔POP0J
LAC COLMIN↔DAC COL ;CARRIAGE RETURN.
GO LFEED
DECLARE{EXTRA}
ENDR LNJUST;9/20/73(BGB)---------------------------------------------
SUBR(TJLINE) ;CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
COMMENT .---------------------------------------------------------------------.
;SKIP OVER LEADING SPACES.
DZM TOTAL
PUSH P,TXTPTR↔PUSH P,CHRCNT ;SAVE SCANNER POSITION.
CALL(GETCHR)↔CAIE 1,40↔GO L1+1
POP P,0↔POP P,0↔GO TJLINE ;FLUSH THE STACK.
;FETCH A CHARACTER AND DO CONVERSIONS.
L1: CALL(GETCHR)
CAIN 1,32↔GO L1 ;IGNORE NULLS.
CAIN 1,00↔GO L1 ;IGNORE TILDE.
CAIN 1,11↔MOVEI 1,40 ;CONVERT TABS TO BLANKS.
;LINE TERMINATION ON CR OR ESCAPE
CAIN 1,15↔GO L2
CAIN 1,"{"↔GO L2
;ACCUMULATE CHARACTER WIDTH INTO TOTAL.
LAC 2,FONT↔LAC 2,FONTAB(2) ;FONT BASE ADDRESS.
ADD 2,1↔CAR 0,(2) ;WIDTH OF CHARACTER.
ADDM 0,TOTAL↔GO L1
;SET COLUMN FOR CENTER OR RIGHT JUSTIFICATION.
L2: LAC COLMAX↔SUB COLMIN↔SUB TOTAL ;EXTRA SPACE IN XGP UNITS.
MOVM↔SKIPGE TJFLAG↔ASH -1 ;HALVE WHEN CENTERING.
ADD COLMIN↔DAC COL
DZM TJFLAG
;RESTORE THE SCANNER AND EXIT.
POP P,CHRCNT↔POP P,TXTPTR
POP0J
DECLARE{TOTAL}
ENDR TJLINE;-------------------------------------------------------------------
;FONT SELECT DELIMITERS.
FSD:BLOCK 7
;FIVE PAIRS: {} () [] ⊂⊃ ≤≥
;DECLARE FONT SELECT DELIMITER - COMMANDS {N; (N; [N; ⊂N; ≤N;
DFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI DFS↔ADDI FSD ;FONT SELECT TABLE POINTER.
CALL(GETCHR)
CAIGE 1,"0"↔POP0J
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
DIP 1,@↔SKIPE FONTAB(1)↔POP0J ;IS IT LOADED YET.
PUSH P,FONT↔DAC 1,FONT
LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(DEFONT,FONT)↔POP P,FONT
POP0J
;LEFT FONT SELECT DELIMITER - TEXT MODE SELECT FONT.
LFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI LFS↔ADDI FSD
CAR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
EXCH 1,FONT↔DAP 1,@ ;SAVE RETURN FONT NUMBER.
CALL(SETFNT)
POP0J
;RIGHT FONT SELECT DELIMITER - TEXT MODE RESTORE FONT.
RFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI RFS↔ADDI FSD
CDR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
DAC 1,FONT
CALL(SETFNT)
POP0J
SUBR(MKSEG0) MAKE LINE SEGMENT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,Q,N} ↔ DR←←R2 ↔ DC←←C2
SKIPE HEAVY↔CALL(MKSEG1)
;CLIPPING - EASY INSIDER.
SETO
SKIPL R1↔CAIL R1,MROWS↔SETZ
SKIPL C1↔CAIL C1,NCOLS↔SETZ
SKIPL R2↔CAIL R2,MROWS↔SETZ
SKIPL C2↔CAIL C2,NCOLS↔SETZ
DAC FLAG#
;CLIPPING - EASY OUTSIDER.
L0: CAML R2,R1↔GO .+3 ;FORCE DOWN VECTOR.
EXCH R1,R2↔EXCH C1,C2
SKIPL R2↔CAIL R1,MROWS↔POP0J ;ROWS OUT OF BOUNDS.
LAC 0,C1↔LAC 1,C2
CAML 0,1↔EXCH 0,1
SKIPL 1↔CAIL 0,NCOLS↔POP0J ;COLUMNS OUT OF BOUNDS.
;INITIALIZE BIT PACK LOOP.
SUB R2,R1↔SUB C2,C1 ;DELTA ROWS & COLUMNS.
MOVEI (<AOS>) ;LEFT TO RIGHT VECTOR.
SKIPGE DC↔MOVEI (<SOS>) ;RIGHT TO LEFT VECTOR.
DIP L2+1↔DIP L5+1↔MOVMS DC ;OLDE FASHION PDP-1 DIP.
LAC N,DC↔CAMGE N,DR↔LAC N,DR ;NUMBER OF DOTS.
ASH DC,=17↔IDIV DC,N↔LAC DC ;DELTA COL PER DOT.
ASH DR,=17↔IDIV DR,N↔DAC DC ;DELTA ROW PER DOT.
DIP DR,DC↔SETZ Q↔SETO ;REMAINDER & BIT.
SKIPN FLAG↔GO L3
;LINE SEGMENT FULLY WITHIN WINDOW.
L1: DOT(R1,C1)↔ADD Q,DC ;PLOT THE DOT & ADVANCE.
TLZE Q,%↔AOS R1 ;ROW OVERFLOW.
L2: TRZE Q,%↔AOS C1 ;COL OVERFLOW.
SOJGE N,L1↔POP0J
;LINE SEGMENT PARTIALLY WITHIN WINDOW.
L3: JUMPL R1,L4↔CAIL R1,MROWS↔POP0J
JUMPL C1,L4↔CAIL C1,NCOLS↔GO L4
DOT(R1,C1)
L4: ADD Q,DC
TLZE Q,%↔AOS R1 ;ROW OVERFLOW.
L5: TRZE Q,%↔AOS C1 ;COL OVERFLOW.
SOJGE N,L3↔POP0J
ENDR MKSEG0;28 MARCH 1974 BGB;---------------------------------------
SUBR(MKSEG1) ;MAKE HEAVY LINES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,DR,DC,N}
LAC N,HEAVY↔PUSH P,HEAVY↔SETZM HEAVY
LAC DR,R1↔SUB DR,R2↔MOVMS DR
LAC DC,C1↔SUB DC,C2↔MOVMS DC
L1: SAVAC(8)↔CALL(MKSEG0)↔GETAC(8)
SOJLE N,[POP P,HEAVY↔POP0J]
CAMGE DR,DC↔GO[
AOS R1↔AOS R2↔GO L1] ;DOWNWARDS.
AOS C1↔AOS C2↔GO L1] ;RIGHTWARDS.
ENDR MKSEG1;28 MARCH 1974 BGB ---------------------------------------
SUBR(UNDERB)
COMMENT .---------------------------------------------------------------------.
SETCMM FLAG
SKIPE FLAG↔GO[LAC ROW↔DAC R1↔LAC COL↔DAC C1↔POP0J] ;FIRST TIME THRU.
LAC ROW↔DAC R2↔LAC COL↔DAC C2
MOVEI 3↔ADDM R1↔ADDM R2
LAC 2,R1↔LAC 3,C1↔LAC 4,R2↔LAC 5,C2↔CALL(MKSEG0)
AOS R1↔AOS R2↔LAC 2,R1↔LAC 3,C1↔LAC 4,R2↔LAC 5,C2↔CALL(MKSEG0)
AOS R1↔AOS R2↔LAC 2,R1↔LAC 3,C1↔LAC 4,R2↔LAC 5,C2↔CALL(MKSEG0)
POP0J
FLAG: 0
INTEGER R1,C1,R2,C2
ENDR UNDERB;-------------------------------------------------------------------
SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{X,Y,R,C,IIIWRD}
;DELTA ORIGIN DISPLACEMENT.
MOVSI 1,(2B2)↔LAC CHAR↔DAC CMDCHR#
CAIN "*"↔SETZ 1,↔DAC 1,DELTA
;III FILE NAME.
CALL(GETFIL)↔POP0J
INIT 17,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/PLT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/III/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/DAT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/TMP/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[FATAL<III OR VIDEO FILE NOT FOUND.>]
GO L0]↔GO L0]↔GO L0]↔GO L0]
;EXPAND CORE FOR DUMP INPUT.
L0: LAC JOBREL↔DAC OLD44#
HLRE 1,PPPN↔MOVN 1,1
ADD 1,JOBREL↔DAC 1,BUFEND#
CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]
;SAVE CURRENT XGP BEAM POSITION.
LAC FONT↔DAC BEGFNT#
LAC COL↔DAC BEGCOL#
LAC ROW↔DAC BEGROW#
MOVEI 2↔DAC IIISIZ ;INITIAL III CHARACTER SIZE.
;DUMP III FILE IN.
LAC OLD44↔SOS↔DAP PPPN↔IN 17,PPPN
LAC 1,OLD44↔LAC(1)↔CAMN [-1]↔GO[ ;HE-VIDEO.
LAC CMDCHR↔CAIE "+"↔GO VIDEO↔GO VIDEO2] ;4 BY 4 OR 6 BY 6.
LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC# ;III PC.
SKIPN 1(1)↔AOS PC ;STEP OVER QUAM'S DEAD WORD.
L1: CDR 1,BUFEND↔DZM(1) ;DAMN SURE OF END STATEMENT.
CDR JOBREL↔DAP JOBFF
;FETCH AND DECODE III COMMAND WORD.
ILOOP: AOSA 1,PC
LOOP: LAC 1,PC↔CAMLE 1,OLD44
CAML 1,BUFEND↔GO RET
LAC IIIWRD,(1)
TRNE IIIWRD,01↔GO XTEXT ;TEXT COMMAND WORD.
TRNE IIIWRD,02↔GO XVECTR ;VECTOR COMMAND WORD.
TRNE IIIWRD,20↔GO XCTRL ;III CONTROL WORD.
TRNE IIIWRD,37↔GO ILOOP ;NOP & HALT COMMANDS.
RET: LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET: RELEASE 17,
LAC BEGFNT↔DAC FONT
LAC BEGCOL↔DAC COL
LAC BEGROW↔DAC ROW
POP0J
;EXECUTE III TEXT.
XTEXT: PUSH P,IIIWRD ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,0(P)↔JUMPE 1,CCONT↔DAC 1,CHAR
CAIN 1,15↔GO[
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-12
MOVNS 1↔ADDM 1,YBEAM
LAC 1,[-511]↔DAC 1,XBEAM↔GO CCONT]
PUSH P,ROW↔PUSH P,COL ;SAVE XGP-BEAM POSITION.
;COMPUTE XGP ROW AND COLUMN.
MOVN R,YBEAM↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW↔DAC R,ROW
LAC C,XBEAM↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL↔DAC C,COL
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-13↔ADDM 1,XBEAM
;COMPUTE FONT SIZE.
LAC 1,IIISIZ↔LAC CHRWID(1)↔FLOAT↔FMP SCALEX↔FIXX↔MOVEI 1,1
CAIL 0,=7↔AOS 1
CAIL 0,=20↔AOS 1↔CAIL 0,=25↔AOS 1
CAIL 0,=30↔AOS 1↔CAIL 0,=40↔AOS 1
CAIN 1,1↔GO[LAC 1,CHAR↔SETO↔CAIN 1,40↔GO CCONT2
LAC R,ROW↔LAC C,COL
CAMG R,ROWMAX↔CAMGE R,ROWMIN↔GO CCONT2
DOT(R,C)↔GO CCONT2]
CAMN 1,FONT↔GO CCONT3↔DAC 1,FONT
SKIPE FONTAB(1)↔GO CCONT4
DAC 1,FONT↔LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(DEFONT,FONT)
CCONT4: LAC 1,FONT↔CALL(SETFNT)
CCONT3: LAC 1,CHAR↔CALL(PRINT)
CCONT2: POP P,COL↔POP P,ROW ;RESTORE XGP-BEAM POSITION.
CCONT: SOSLE -1(P)↔GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP
;EXECUTE III CONTROL OPERATIONS.
XCTRL: TRNN IIIWRD,04↔GO[CAR 1,IIIWRD↔DAC 1,PC↔GO LOOP] ;JUMP.
TRNE IIIWRD,40↔GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
CAR 2,IIIWRD
CAMLE 2,OLD44
CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
DAC 1,(2)↔DAC 2,PC
GO ILOOP
;EXECUTE VECTORS.
XVECTR: TRNN IIIWRD,4
GO [TRNN IIIWRD,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,IIIWRD,10]↔ROT -13↔DAC X ;X FIELD.
LDB [POINT 11,IIIWRD,21]↔ROT -13↔DAC Y ;Y FIELD
LDB [POINT 3,IIIWRD,24]↔SKIPE↔DAC IIIBRT ;BRIGHTNESS
LDB [POINT 3,IIIWRD,27]↔SKIPE↔DAC IIISIZ ;CHR SIZE
LDB 1,[POINT 3,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
SVECT: PUSH P,IIIWRD ;SAVE III COMMAND.
LDB [POINT 7,IIIWRD,06]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,13]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,15]↔CALL(VECTOR) ;OP CODE.
POP P,IIIWRD ;RESTORE III COMMAND.
LDB [POINT 7,IIIWRD,22]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,29]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
VECTOR: SETO↔TRNE 1,2↔SETZ ;SKIP ON VISIBLE VECTOR.
TRNE 1,4↔GO .+3 ;SKIP ON RELATIVE VECTOR.
ADD X,XBEAM↔ADD Y,YBEAM
DAC X,XBEAM↔DAC Y,YBEAM
MOVN R,Y↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW ;Y INTO ROW.
LAC C,X↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL ;X INTO COL.
TRNE 1,1↔GO VPOINT ;SKIP NOT POINT VECTOR.
LAC 2,ROW↔LAC 3,COL ;FROM OLD XGP BEAM POSITION.
DAC R,ROW↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
SKIPE↔CALL(MKSEG0)↔POP0J ;PLOT VECTOR - POP STACK.
;PLOT A DOT 3 BY 3.
VPOINT: SOS R↔DAC R,ROW↔SOS C↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,1
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,2
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)↔POP0J
DECLARE{XBEAM,YBEAM,IIIBRT,IIISIZ}
CHRWID: 0↔8↔12↔14↔16↔24↔32↔48 ;III CHARACTER WIDTHS.
ENDR IIISIM;2/8/73(TVR)8/21/73(BGB)----------------------------------
DELTA: 0
SUBR(VIDEO)
COMMENT .---------------------------------------------------------------------.
;VIDEO FILE HEADER: 0/-1 ↔ 1/6 BITS/BYTE ↔ 2/=48 WORDS/ROW
;VIDEO FILE HEADER: 3/R1 ↔ 4/R2 ↔ 5/C1 ↔ 6/C2 ↔ 7/ -WC,,ADR
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2,R,C,TV}
;EXPECT AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH#
LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS#
LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS#
LAC R,ROW↔SKIPN DELTA↔GO[LAC TVROWS↔ASH 1↔SUB R,0↔GO .+1] ;XGP ORG ROW.
;VIDEO BYTE POINTER.
L0: LAC P1,1(TV)↔IORI P1,4400↔ROT P1,-=12 ;BYTE SIZE & P-FIELDS.
HRR P1,7(TV)↔ADD P1,1 ;ORIGIN OF VIDEO IN CORE.
;POINTER INTO XGP BUFFER.
LAC C,COL↔SKIPN DELTA↔GO[LAC TVCOLS↔ASH 1↔SUB C,0↔GO .+1] ;XGP ORG COL.
; TRZ R,3 ;UPPER LEFT MOST CORNER OF IMAGE.
;J = COLUMNS/9 9 4-BIT XGP BYTES PER WORD.
MOVEI J,=36↔IDIV J,1(TV)
IMUL J,2(TV)↔IDIVI J,=9↔DAC J,JSAV# ;COLUMNS/9
LAC I,TVROWS↔DAC C,CSAVE#
L1: LAC C,CSAVE↔LAC J,JSAV
JUMPL R,L2
JUMPL C,[LAC 1,COLMIN↔HLLZ 1,XGP2D(1)↔GO .+2]
HLLZ 1,XGP2D(C)↔ROT 1,6 ;FIRST COLUMN.
HRRI 1,@XGP2D(R)↔CDR P2,1 ;BIT POINTER INTO XGP BUFFER;
L2: SETZB 0,1↔SETZB 2,3↔MOVEI K,=9
L3: ILDB Q,P1↔TRZ Q,3↔ROTC 0,4↔ROTC 2,4
ADDI C,4↔CAMG C,COLMAX↔CAMGE C,COLMIN↔GO .+5
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)↔SOJG K,L3
CAMGE R,ROWMIN↔GO L4
CAMGE C,COLMIN↔GO L4+1
IORM 0,0*WWIDTH(P2)↔IORM 1,1*WWIDTH(P2)
IORM 2,2*WWIDTH(P2)↔IORM 3,3*WWIDTH(P2)
L4: AOS P2↔SOJG J,L2
ADDI R,4↔CAMLE R,ROWMAX↔POP0J ;LOGICAL BOTTOM MARGIN
SOJG I,L1
POP0J
;HALF TONE TABLE.
HTT: 6↔7↔7↔6↔ 6↔6↔7↔6↔ 6↔6↔6↔6↔ 6↔6↔6↔6
6↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔4↔6↔4
4↔4↔4↔4↔ 4↔4↔4↔4↔ 0↔4↔4↔4↔ 4↔4↔4↔0
0↔4↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔0↔0
ENDR VIDEO;6/2/73(BGB)-----------------------------------------------
SUBR(VIDEO2)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{S2,S3,S4,S5,I,J,K,Q,P0,P1,P2,TV}
;EXPECTS AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH# ;WORDS PER ROW.
LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS# ;NUMBER OF ROWS.
LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS# ;NUMBER OF COLUMNS.
L0: LAC P1,1(TV)↔IORI P1,4400↔ROT P1,-=12 ;VIDEO BYTE POINTER
HRR P1,7(TV)↔ADD P1,1 ;FIRST-1 PIXEL.
LAC P2,ORGXGP↔ADDI P2,WWIDTH-1 ;LAST WORD OF FIRST ROW.
;LOOP I←1,288 TV COLUMNS.
MOVEI I,=288 ;NUMBER OF TVCOLUMNS.
L1: IBP P1↔DAC P1,P0
;LOOP J←1,(206/6) TV ROWS.
MOVEI J,=35 ;NUMBER OF TV ROWS/6.
L2: SETZB 0,1↔SETZB 2,3↔SETZB 4,5 ;CLEAR 6 WORDS FOR XGP BITS.
;LOOP K←1,6 FOR SIX VIDEO PIXELS.
MOVEI K,=6
L3: LDB Q,P0↔ADD P0,TVWIDTH ;TV PIXEL & NEXT TV ROW.
TRZ Q,3↔LSH Q,1
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
IOR 4,HTT+4(Q)↔IOR 5,HTT+5(Q)
ROTC 0,-6↔ROTC 2,-6↔ROTC 4,-6
SOJG K,L3 ;LOOP FOR SIX VIDEO PIXELS.
;PACK SIX VIDEO PIXELS INTO XGP-BUFFER.
IORM 1,0*WWIDTH(P2)↔IORM 0,1*WWIDTH(P2)
IORM 3,2*WWIDTH(P2)↔IORM 2,3*WWIDTH(P2)
IORM 5,4*WWIDTH(P2)↔IORM 4,5*WWIDTH(P2)
L4: SOS P2↔SOJG J,L2 ;LEFT 36 XGP PIXELS.
ADDI P2,7*WWIDTH-1 ;DOWN 7 XGP ROWS (6 ROWS PER TV-COL + 1 ROW TO BACKUP ON)
SOJG I,L1↔POP0J ;LOOP FOR TV ROWS/6.
;6 BY 6 HALF TONE TABLE.
HTT: 17↔17↔17↔17 ↔0↔0↔0↔0 ;00 DARK.
7↔17↔17↔17 ↔0↔0↔0↔0
7↔ 7↔17↔17 ↔0↔0↔0↔0
7↔ 7↔ 7↔17 ↔0↔0↔0↔0
17↔17↔17↔00 ↔0↔0↔0↔0
17↔17↔ 7↔00 ↔0↔0↔0↔0
17↔ 7↔ 7↔00 ↔0↔0↔0↔0
7↔ 7↔ 7↔00 ↔0↔0↔0↔0
7↔ 7↔ 3↔00 ↔0↔0↔0↔0
7↔ 7↔ 1↔00 ↔0↔0↔0↔0
7↔ 7↔ 0↔00 ↔0↔0↔0↔0
3↔ 7↔ 0↔00 ↔0↔0↔0↔0
0↔ 0↔ 1↔ 7 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 7 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 3 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 1 ↔0↔0↔0↔0
ENDR VIDEO2;BGB 25 MAY 1974 ---------------------------------------------
SUBR(INFILE) INDIRECT FILE COMMAND "@".
COMMENT .-----------------------------------------------------------.
;FILE INITIALIZATION.
INIT 1,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
CALL(GETFIL)↔POP0J
LOOKUP 1,FILNAM↔GO[
OUTSTR[ASCIZ/FILE NOT FOUND - /]
POP P,1↔LAC 2,[POINT 7,4]↔MOVEI 3,=25
ILDB 1↔CAIN";"↔GO $.+3↔IDPB 2↔SOJG 3,$.-4
SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT]
;EXPAND CORE WHEN NECESSARY.
HLRE PPPN↔MOVMS↔DAC SIZE# ;WORD COUNT.
IMULI =5↔DAC CHRCNT ;NEW CHARACTER COUNT.
LAC 1,TXTORG↔ADD 1,SIZE↔DAP 1,JOBFF ;NEW TOP OF CORE.
CDR 1,JOBFF↔CAMG 1,JOBREL↔GO .+3 ;EXPAND CORE.
CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]
;INPUT THE FILE.
CDR TXTORG↔HRLI 700↔DAC TXTPTR ;RESET TEXT POINTER.
HLL PPPN↔DAC DUMARG ;DUMP MODE ARGUMENT.
IN 1,DUMARG↔SKIPA↔HALT ;INPUT THE FILE.
RELEASE 1,↔DZM CMODE ;ENTER TEXT MODE.
;SKIP OVER TEXT DIRECTORY IF IT EXISTS.
LAC 2,TXTPTR
LAC 3,[POINT 7,[ASCIZ/COMMENT ⊗ VALID/]]
ILDB 0,2↔ILDB 1,3↔JUMPN 1,[
CAME 0,1↔POP0J↔GO .-2]
CALL(GETCHR)
CAIE 1,14↔GO .-2↔POP0J
DUMARG:0↔0
ENDR INFILE;5/30/73(BGB)---------------------------------------------
;XIP GRAPHICS COMMAND EXECUTION: I,V,R
;INVISIBLE VECTOR.
AI: CALL(NEXTCHR)↔CAIE 1,"∂"↔SETZM ROW
CALL(REALIN)↔FIXX↔ADDM ROW
CALL(NEXTCHR)↔CAIE 1,"∂"↔SETZM COL
CALL(REALIN)↔FIXX↔ADDM COL↔POP0J
;ABSOLUTE VISIBLE VECTOR.
AV: SETZB 4,5
CALL(NEXTCHR)↔CAIN 1,"∂"↔LAC 4,ROW
CALL(REALIN)↔FIXX↔ADD 4,0
CALL(NEXTCHR)↔CAIN 1,"∂"↔LAC 5,COL
CALL(REALIN)↔FIXX↔ADD 5,0
LAC 2,ROW↔LAC 3,COL ;FROM HITHER.
DAC 4,ROW↔DAC 5,COL ; TO YON.
CALL(MKSEG0)↔POP0J
;RADIAL VECTOR AT DEFAULT ORIENTATION ABOUT PSEUDO BEAM POSITION.
XRADIAL: ;R <radius1> <radius2>
CALL(REALIN)↔DAC 5↔DAC 5,4
CALL(REALIN)↔DAC 3↔DAC 3,2
FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
CALL(MKSEG0)↔POP0J
;XIP GRAPHICS COMMAND EXECUTION: X,Y,O,L
XXSCAL:
CALL(REALIN)↔DAC SCALEX↔DAC SCALEY ;X <Xscale>,≤YSCALE≥;
FMPR[1024.]↔FIXX↔DAC IIIDX↔DAC IIIDY
CAIE 1,","↔POP0J
CALL(REALIN)↔DAC SCALEY ;Y <scale> ;
FMPR[1024.]↔FIXX↔DAC IIIDY↔POP0J
XROTAT:
CALL(READARC)↔PUSH P,1↔DAC ROTDEL ;O <angle> ;
SETQ(SINE,{SIN,ROTDEL})
SETQ(COSINE,{COS,ROTDEL})
POP P,1↔CAIE 1,","↔POP0J
CALL(REALIN)↔DAC LOCUSX ;relative origin.
CALL(REALIN)↔DAC LOCUSY
POP0J
XLOCUS:
CALL(REALIN)↔FADR LOCUSX↔FIXX↔DAC COL ;L <X>, <Y>;
CALL(REALIN)↔FSBR LOCUSY↔FIXX↔MOVNM ROW
XLOC2: CAIE 1,","↔POP0J
CALL(REALIN)↔FADR LOCUSX↔FIXX↔LAC 3,COL↔DAC COL↔LAC 5,COL
CALL(REALIN)↔FSBR LOCUSY↔FIXX↔LAC 2,ROW↔MOVNM ROW↔LAC 4,ROW
PUSH P,1↔CALL(MKSEG0)↔POP P,1
GO XLOC2
LOCUSX: 630.0
LOCUSY: 950.0
;COMMAND EXECUTION P,H,α
XSETPAGE:
CALL(REALIN)↔FIXX↔MOVMM PAGENO↔POP0J ;P <page number>;
XAOSPAGE: AOS PAGENO↔POP0J
XHEAVY:
CALL(REALIN)↔FIXX↔MOVMM HEAVY↔POP0J ;H <THICKNESS>;
SUBR(SQRT,X)
COMMENT .-----------------------------------------------------------.
A←0 ↔ B←←1 ↔ C←2
MOVM B,X↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J
ENDR SQRT;--------------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,-1(P)
↑SIN: SKIPA A,-1(P)
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:201622077325↔LIT ;PI/2
BEND;-------------------------------------------------------------
HALFPI: 201622077325 ;PI/2
PI: 202622077325 ;PI
SUBR(REALIN)
COMMENT .-----------------------------------------------------------.
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
ENDR REALIN;-------------------------------------------------------------------
;INPUT SMALL REAL NUMBER.
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
SUBR(PRIMARY)
COMMENT .---------------------------------------------------------------------.
CNT ←← 2 ;DIGIT COUNTER.
SETZB SIGNFLAG#
PUSH P,CNT↔SETZ CNT,
L0: CALL(GETCHR)
CAIN 1," "↔GO L0
CAIN 1,"∂"↔GO L0
CAIN 1,"-"↔GO[SETCMM SIGNFLAG↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: CALL(GETCHR)↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔POP P,2↔POP0J]
SKIPA
L1: CALL(GETCHR) ;FURTHER DIGITS.
CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE SIGNFLAG↔MOVNS
POP P,2↔POP0J
ENDR PRIMARY;------------------------------------------------------------------
SUBR(READARC)
COMMENT .-----------------------------------------------------------.
CALL(REALIN)
JUMPL[CAMG[6.3]↔FMPR[0.0174533]↔POP0J]
CAML[6.3]↔FMPR[0.0174533]
POP0J
ENDR READARC;--------------------------------------------------------
SUBR(DPYDOT,X,Y) ;DISPLAY A DOT.
COMMENT .---------------------------------------------------------------------.
;PLACE A DOT AT LOCUS (X,Y).
;DILATION, ROTATION, TRANSLATION, & CLIP.
ACCUMULATORS{R,C}
LAC R,X↔LAC C,Y
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
CAMGE R,ROWMIN↔POP2J ;CLIP.
CAMLE R,ROWMAX↔POP2J
SKIPGE C↔POP2J
CAILE C,NCOLS
SETO↔DOT(R,C)↔POP2J ;DISPLAY.
ENDR DPYDOT;-------------------------------------------------------------------
SUBR(MKSEG3)
COMMENT .---------------------------------------------------------------------.
R←←2 ↔ C←←3
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
R←←4 ↔ C←←5
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL↔GO MKSEG0
ENDR MKSEG3;-------------------------------------------------------------------
SUBR(RNDBOX,WID,HGH,RAD) ;BOX WITH ROUNDED CORNERS AT ROW,COL.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,R,C}
LAC R1,ROW↔SUB R1,HGH↔AOS R1↔DAC R1,R2
LAC C1,COL↔SUB C1,WID↔ADD C1,RAD↔SUBI C1,2
LAC C2,COL↔ADD C2,WID↔SUB C2,RAD↔ADDI C2,2
CALL(MKSEG0) ;NORTH EDGE.
LAC R1,ROW↔ADD R1,HGH↔SUB R1,HEAVY↔AOS R1↔DAC R1,R2
LAC C1,COL↔SUB C1,WID↔ADD C1,RAD↔SUBI C1,2
LAC C2,COL↔ADD C2,WID↔SUB C2,RAD↔ADDI C2,2
CALL(MKSEG0) ;SOUTH EDGE.
LAC C1,COL↔SUB C1,WID↔DAC C1,C2
LAC R1,ROW↔SUB R1,HGH↔ADD R1,RAD
LAC R2,ROW↔ADD R2,HGH↔SUB R2,RAD
CALL(MKSEG0) ;WEST EDGE.
LAC C1,COL↔ADD C1,WID↔SUB C1,HEAVY↔DAC C1,C2
LAC R1,ROW↔SUB R1,HGH↔ADD R1,RAD
LAC R2,ROW↔ADD R2,HGH↔SUB R2,RAD↔CALL(MKSEG0) ;EAST EDGE.
LAC RAD↔FLOAT↔DAC FRAD# ;FLOAT THE RADIUS.
LAC R,ROW↔DAC R,SAVROW# ;SAVE BEAM POSITION.
LAC C,COL↔DAC C,SAVCOL#
SUB R,HGH↔ADD R,RAD↔DAC R,ROW
ADD C,WID↔SUB C,RAD↔DAC C,COL
CALL(CIRC,FRAD,[0],HALFPI) ;NORTHEAST CORNER.
LAC RAD↔SUB WID↔ASH 1↔ADDM COL
CALL(CIRC,FRAD,HALFPI,HALFPI) ;NORTHWEST CORNER.
LAC HGH↔SUB RAD↔ASH 1↔ADDM ROW
CALL(CIRC,FRAD,PI,HALFPI) ;SOUTHWEST CORNER.
LAC WID↔SUB RAD↔ASH 1↔ADDM COL
MOVN HALFPI↔CALL(CIRC,FRAD,0,HALFPI) ;SOUTHEAST CORNER.
LAC SAVROW↔DAC ROW↔LAC SAVCOL↔DAC COL ;RESTORE BEAM POSITION.
POP3J
ENDR RNDBOX;-------------------------------------------------------------------
SUBR(XBOX) ;"B <width> <height>"
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{X1,Y1,X2,Y2}
SETZM PDZ#
CALL(REALIN) ↔ MOVMM PDX# ↔ MOVNM NDX# ↔ CAIE 1,";"
CALL(REALIN) ↔ MOVMM PDY# ↔ MOVNM NDY# ↔ CAIE 1,";"↔GO[
CALL(REALIN) ↔ MOVMM PDZ# ↔ GO .+1]
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,PDY↔CALL(MKSEG3) ;WEST.
LAC X1,PDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;EAST.
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
LAC X1,NDX↔LAC Y1,PDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
SKIPN PDZ↔POP0J
L1: LAC PDZ↔FADRB NDY↔CAML PDY↔POP0J ;ADD DELTA'S
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH SHALL RISE.
GO L1
ENDR XBOX;--------------------------------------------------------------------.
SUBR(XSWINE) ;"S <WIDTH> <HEIGHT> <RADIUS> "
COMMENT .---------------------------------------------------------------------.
CALL(REALIN)↔DAC 7 ;HALF WIDTH
CALL(REALIN)↔DAC 8 ;HALF HEIGHT.
CALL(REALIN)↔DAC 9 ;RADIUS.
FIXX 7,↔FIXX 8,↔FIXX 9,
CALL(RNDBOX,7,8,9)↔POP0J
ENDR XSWINE;-------------------------------------------------------------------
SUBR(CARTOUCHE) ;"|" CARTOUCHE DELIMITER.
COMMENT .---------------------------------------------------------------------.
LAC ROW↔SKIPN ROW0↔GO[DAC ROW0
LAC COLMIN↔DAC CMIN↔ADDI =50↔DAC COLMIN
LAC COLMAX↔DAC CMAX↔SUBI =50↔DAC COLMAX↔POP0J] ;NARROW THE MARGINS.
DAC ROW1
PUSH P,ROW↔PUSH P,COL↔PUSH P,HEAVY ;SAVE STATUS.
MOVEI 7↔DAC HEAVY
MOVEI NCOLS↔ASH -1↔DAC COL ;MIDDLE OF THE PAGE.
LAC ROW0↔ADD ROW1↔ASH -1↔DAC ROW ;MIDDLE OF THE BOX.
LAC ROW1↔SUB ROW0↔ASH -1
CALL(RNDBOX,[=630],0,[=72])
POP P,HEAVY↔POP P,COL↔POP P,ROW ;RESTORE STATUS.
LAC CMIN↔DAC COLMIN↔LAC CMAX↔DAC COLMAX ;RESTORE THE MARGINS.
DZM ROW0↔POP0J
DECLARE{ROW0,ROW1,COL0,COL1,CMIN,CMAX}
ENDR CARTOUCHE;----------------------------------------------------------------
SUBR(CIRC,RAD,ARCORG,ARCLEN) ;RADIUS - ARC ORG - ARC LENGTH.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{R,C,X,Y,N,M,E}
LAC M,HEAVY
L1: CALL(COS,ARCORG)↔FMPR 1,RAD↔FIXX 1,↔DAC 1,XX
CALL(SIN,ARCORG)↔FMPR 1,RAD↔FIXX 1,↔DAC 1,YY
MOVM R,RAD↔FIXX R,
CAIG R,1↔GO[LAC R,ROW↔LAC C,COL↔SETO↔DOT(R,C)↔POP3J]
JFFO R,.+1↔MOVEI E,-=36(C) ;ARC EPSILON = 1/R > 1/2↑E
LAC N,ARCLEN↔MOVN 1,E
FSC N,(1)↔FIXX N,↔DAC N,NN ;ACTUAL DOT COUNT ← ARCLEN*2↑E
SETO
LAC X,XX↔LAC Y,YY↔LAC N,NN ;PICKUP ARGUMENTS.
ASH X,=18↔ASH Y,=18
L2: HLRE C,X↔HLRE R,Y↔MOVNS R
ADD R,ROW↔ADD C,COL
CAMGE R,ROWMIN↔GO L3 ;CLIP TO ROW LIMITS.
CAMLE R,ROWMAX↔GO L3
JUMPL C,L3↔CAIL C,NCOLS↔GO L3 ;CLIP TO COLUMN LIMITS.
DOT(R,C)
L3: LAC 1,Y↔ASH 1,(E)↔SUB X,1 ;X ← X - Y/2↑-E
LAC 1,X↔ASH 1,(E)↔ADD Y,1 ;Y ← Y + X/2↑-E
SOSLE N↔GO L2
SOSGE M↔POP3J ;HEAVINESS.
LAC RAD↔FSB[1.0]↔DAC RAD
GO L1
DECLARE{XX,YY,NN}
ENDR CIRC;---------------------------------------------------------------------
SUBR(XCIRCLE)
COMMENT .---------------------------------------------------------------------.
SETZ 8,↔LAC 9,[6.29] ;DEFAULTS.
CALL(REALIN)↔PUSH P,0↔CAIN 1,";"↔GO L2 ;RADIUS.
CALL(REALIN)↔DAC 8↔CAIN 1,";"↔GO L2 ;ARC ORGIN.
CALL(REALIN)↔DAC 9 ;ARC LENGTH.
L2: CALL(CIRC,8,9)↔POP0J
ENDR XCIRCLE;------------------------------------------------------------------
FUCK: SETZM COL↔POP0J
END SA